绘制小提琴图

## 方法1:箱线图  ##这个可以用来展示不同月份或者不同物种之间的 差异;
bwplot(tmin.all.c) ##这里是对栅格数据集进行绘制;

## 方法2:基于ggplot2绘制:
## 导入文件为行列对应的点值矩阵;
profile_text <- read.table(text=profile, header=T, row.names=1, quote="",sep=";", check.names=F)
library(reshape2)
library(ggplot2)
data_m <- melt(profile_text)

## 多个:
ggplot(data = t, aes(x = month, y = tmp)) +
  geom_violin() +
  ylab("Temperature (˚C)") +
  labs(title = "Global Monthly Mean Land Surface Temperatures From 1960-1991",
       subtitle = "Excludes Antarctica")

绘制分组环境环境变量核密度图

## 方法1:
### 基于plot函数:

sa_e <-data.frame(na.exclude(raster::extract(envs,xh_sa[,2:3])))
order = c(paste0("BIO",1:7), paste0("BIO",10:17),"FRS","WET","GHI","PET_ANN","MOIS","AI","GDD0","GDD5")
sa_e = sa_e[order]

View(sa_e)
op <- par(mar = rep(2, 4))  
par(mfrow =c(5,5)) 
for(i in 1:23){
  nam <- names(sa_e)
  plot(density(sa_e[,i]),main=nam[i],yaxt="n",bty="L")
}

## 方法2:
## 出图目的:
1.可视化不同物种同一因子的响应差异;
2.可视化同一物种因子的峰形;
## 养成习惯,设置工作路径:
rm(list = ls())
setwd("D:\\zhang")
localdata <- read.csv("bjpoints.csv")
tiffs <- list.files("./preasc",pattern = "asc",full.names = TRUE)
library(raster)
ascs <- stack(tiffs)
data <- extract(ascs,localdata[,-1])
###  为画图方便,仅选择其中6种环境变量;
data <- as.data.frame(data[,-7])

## 获取列名:
na <- colnames(data)

### 原始提取数据,提取后出现bug,转为了非数值变量,需要
## 将数据框拆分,提取,转为向量,向量合并为矩阵
## 矩阵再转为数据框,用于数据的 进一步分布
##  注意subset之后的结果仍未数据框;
tt <-list()
for(i in 1:length(na)){
  naa <- paste0(rep("h",6),c(1:6))
  naa[i] <- as.list(round(subset(data,select =c(na[i])),digits=3))
  tt <- c(tt,naa[i])
}

ss <- as.data.frame(do.call(cbind,tt))
names(ss) <- na

bjrh <- rep("bjrh",40)
data1 <- cbind(bjrh,ss)

## View(data)
library(ggplot2)
library(MASS)

data1$bjrh <- factor(data1$bjrh)
nclnames <- colnames(data1[,-1])

## print(nclnames)
## 注意这里的aes(x = 必须填写实际的列名称)

## 下图绘制:没有y轴;
ggplot(data1,aes(x= bio10 ,fill=bjrh))
+ geom_density(alpha =0.3) + guides(fill =FALSE)+ylab("")

## 绘制组图:
## ggplot中绘制组图使用函数:
library(ggpubr)
ggarrange(h1,h2,h3,h4,h5,h6,h7,h8,h9,ncol=3,nrow=3,labels=c(1:9)) 

## 方法3:
## 将直方图和密度图合并绘制:
## 使用plyr包的revalue()函数,重命名因子名称;
## 适合于多物种单因子比较分析:
library(plyr)
birthwt1 <- birthwt
birthwt1$smoke <- factor(birthwt1$smoke)
birthwt1$smoke<- revalue(birthwt1$smoke,c("0"="NO smoke","1"="smoke"))
ggplot(birthwt1,aes(x=bwt,y=..density..))+
  geom_histogram(binwidth = 200,fill="cornsilk",colour="grey60",size=0.2)+
  geom_density()+facet_grid(smoke~.)+ ylab("")

## 方法4:
rep1 <- c(rep("hthis",dim(hthis)[1]),rep("hgyas",dim(hgyas)[1]),
          rep("hsals",dim(hsals)[1]),rep("hses",dim(hses)[1]))
alls2 <- rbind(hthis,hgyas,hsals,hses) %>% cbind(rep1,.) %>% data.frame(.)
names(alls2)[1] <- "class"
head(alls2)

alls2$class <- factor(alls2$class)
attach(alls2)
## 黄色为hsals;红色:hgyas;蓝色:hthis;绿色:hses
# op <- par(mar = rep(2, 4))
# library(sm)
# par(mfrow =c(1,5))
# for(i in 1:5){
#   nam <- bioss3
#   sm.density.compare(eval(parse(text = bioss3[i])),class,xlab=nam[1],ylab="",pch=2,col=c("blue","red","yellow","green"))
#   legend("topright",levels(class),fill= c(2:(1+length(class))))
# }

library(ggplot2)
col=c("blue","red","yellow","green")

pplo <- function(x){
  ggplot(alls2,aes(x= eval(parse(text = bioss3[x])) ,fill=class))+ geom_density(alpha =0.6) +ylab("")+scale_fill_manual(values=col)+guides(fill= FALSE)+
    theme(panel.border = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank()) + 
    scale_y_continuous(breaks=NULL,expand=c(0,0))+theme(panel.grid.major=element_line(colour=NA))+
    theme(axis.line.x=element_line(linetype=1,color="black",size=1))+ theme(axis.text.x = element_text(size = 10,color="black"))+
    theme(axis.title.x = element_text(size=10))+xlab(nam[x])

}
ff <- lapply(1:41,pplo)
cowplot::plot_grid(plotlist = ff)

results matching ""

    No results matching ""